<%
Class FastAsp_Response
    Private m_ContentType    '内容类型
    Private m_Charset        '字符集
    Private m_Headers        '响应头
    Private m_StatusCode     '状态码
    
    Private Sub Class_Initialize()
        m_ContentType = "text/html"
        m_Charset = "utf-8"
        m_StatusCode = 200
        Set m_Headers = Server.CreateObject("Scripting.Dictionary")
    End Sub
    
    '设置内容类型
    Public Function ContentType(byval type_)
        m_ContentType = type_
        Set ContentType = Me
    End Function
    
    '设置字符集
    Public Function SetCharset(byval charsetName)
        m_Charset = charsetName
        Set SetCharset = Me
    End Function
    
    '设置状态码
    Public Function Status(byval code)
        m_StatusCode = code
        Set Status = Me
    End Function
    
    '设置响应头
    Public Function Header(byval name, byval value)
        m_Headers.Add name, value
        Set Header = Me
    End Function
    
    '跳转页面
    Public Sub Jump(byval msg, byval url, byval type_, byval wait)
        If wait = "" Then wait = 3
        If type_ = "" Then type_ = "success"
        
        '判断是否为Ajax请求
        If IsAjax() Then
            Response.Clear
            Response.ContentType = "application/json"
            Response.Charset = "utf-8"
            
            Dim dict : Set dict = Server.CreateObject("Scripting.Dictionary")
            dict.Add "code", IIf(type_ = "success", 1, 0)
            dict.Add "msg", msg
            If url <> "" Then dict.Add "url", url
            If wait <> "" Then dict.Add "wait", wait
            
            Response.Write JSON.Encode(dict)
            Response.End
        End If
        
        '普通请求输出跳转页面
        Dim tpl : tpl = LoadTemplate(GetConfig("JumpTemplate"))
        tpl = Replace(tpl, "{$type}", type_)
        tpl = Replace(tpl, "{$title}", IIf(type_ = "success", "操作成功", "操作失败"))
        tpl = Replace(tpl, "{$msg}", msg)
        tpl = Replace(tpl, "{$url}", url)
        tpl = Replace(tpl, "{$time}", wait)
        
        Response.Clear
        Response.Write tpl
        Response.End
    End Sub
    
    '成功提示
    Public Sub Success(byval msg, byval url, byval wait)
        Jump msg, url, "success", wait
    End Sub
    
    '错误提示
    Public Sub Error_(byval msg, byval url, byval wait)
        Jump msg, url, "error", wait
    End Sub
    
    '输出JSON
    Public Sub WriteJson(byval data)
        Response.Clear
        Response.ContentType = "application/json"
        Response.Charset = "utf-8"
        
        '输出自定义响应头
        Dim key
        For Each key In m_Headers.Keys
            Response.AddHeader key, m_Headers(key)
        Next
        
        On Error Resume Next
        Dim jsonStr, json
        Set json = New FastAsp_JSON
        
        '如果data是字符串,检查是否已经是JSON格式
        If VarType(data) = vbString Then
            data = Trim(data)
            If (Left(data, 1) = "{" And Right(data, 1) = "}") Or _
               (Left(data, 1) = "[" And Right(data, 1) = "]") Then
                jsonStr = data
            Else
                jsonStr = json.Encode(data)
            End If
        ElseIf TypeName(data) = "Dictionary" Then
            '字典对象直接编码
            jsonStr = json.Encode(data)
        ElseIf IsArray(data) Then
            '如果是数组且元素个数为偶数，转换为字典
            If (UBound(data) + 1) Mod 2 = 0 Then
                Dim dict : Set dict = Server.CreateObject("Scripting.Dictionary")
                Dim i
                For i = 0 To UBound(data) Step 2
                    dict.Add data(i), data(i + 1)
                Next
                jsonStr = json.Encode(dict)
            Else
                '不是偶数个元素的数组直接编码
                jsonStr = json.Encode(data)
            End If
        Else
            '其他类型直接编码
            jsonStr = json.Encode(data)
        End If
        
        If Err.Number <> 0 Then
            '如果编码出错,返回错误信息
            Response.Write "{""code"":0,""msg"":""JSON encode error: " & JSEncode(Err.Description) & """}"
        Else
            Response.Write jsonStr
        End If
        On Error Goto 0
        
        Set json = Nothing
        Response.End
    End Sub
    
    'JavaScript字符串编码
    Private Function JSEncode(byval str)
        If IsNull(str) Then
            JSEncode = ""
            Exit Function
        End If
        
        str = Replace(str, "\", "\\")
        str = Replace(str, """", "\""")
        str = Replace(str, vbCrLf, "\n")
        str = Replace(str, vbCr, "\n")
        str = Replace(str, vbLf, "\n")
        str = Replace(str, vbTab, "\t")
        JSEncode = str
    End Function
    
    '输出文本
    Public Sub Write(byval text)
        Response.Clear
        Response.Status = m_StatusCode
        Response.ContentType = m_ContentType & "; charset=" & m_Charset
        
        '输出自定义响应头
        Dim key
        For Each key In m_Headers.Keys
            Response.AddHeader key, m_Headers(key)
        Next
        
        Response.Write text
    End Sub
    
    '下载文件
    Public Sub Download(byval file, byval filename)
        If filename = "" Then filename = Mid(file, InStrRev(file, "/") + 1)
        
        Response.Clear
        Response.AddHeader "Content-Disposition", "attachment; filename=" & filename
        Response.ContentType = GetContentType(filename)
        
        Dim stream : Set stream = Server.CreateObject("ADODB.Stream")
        stream.Type = 1 'adTypeBinary
        stream.Open
        stream.LoadFromFile Server.MapPath(file)
        Response.BinaryWrite stream.Read
        stream.Close
        Set stream = Nothing
        Response.End
    End Sub
    
    '重定向
    Public Sub Redirect(byval url, byval code)
        If code = "" Then code = 302
        Response.Status = code
        Response.AddHeader "Location", url
        Response.End
    End Sub
    
    '判断是否为Ajax请求
    Private Function IsAjax()
        IsAjax = (Request.ServerVariables("HTTP_X_REQUESTED_WITH") = "XMLHttpRequest")
    End Function
    
    '加载模板
    Private Function LoadTemplate(byval file)
        Dim stream : Set stream = CreateObject("ADODB.Stream")
        stream.Type = 2 'adTypeText
        stream.Charset = "utf-8"
        stream.Open
        
        On Error Resume Next
        stream.LoadFromFile Server.MapPath(file)
        If Err.Number <> 0 Then
            LoadTemplate = "<h1>Template file not found: " & file & "</h1>"
            stream.Close
            Set stream = Nothing
            Exit Function
        End If
        On Error Goto 0
        
        LoadTemplate = stream.ReadText
        stream.Close
        Set stream = Nothing
    End Function
    
    '获取内容类型
    Private Function GetContentType(byval filename)
        Dim ext : ext = LCase(Mid(filename, InStrRev(filename, ".") + 1))
        Select Case ext
            Case "jpg","jpeg" GetContentType = "image/jpeg"
            Case "gif"       GetContentType = "image/gif"
            Case "png"       GetContentType = "image/png"
            Case "bmp"       GetContentType = "image/bmp"
            Case "doc","docx" GetContentType = "application/msword"
            Case "xls","xlsx" GetContentType = "application/vnd.ms-excel"
            Case "pdf"       GetContentType = "application/pdf"
            Case "txt"       GetContentType = "text/plain"
            Case "zip"       GetContentType = "application/zip"
            Case "rar"       GetContentType = "application/x-rar-compressed"
            Case Else        GetContentType = "application/octet-stream"
        End Select
    End Function
    
    '显示404页面
    Public Sub Show404()
        Response.Clear
        Response.Status = 404
        
        '判断是否为Ajax请求
        If IsAjax() Then
            Response.ContentType = "application/json"
            Response.Charset = "utf-8"
            
            Dim dict : Set dict = Server.CreateObject("Scripting.Dictionary")
            dict.Add "code", 0
            dict.Add "msg", "页面未找到"
            
            Response.Write JSON.Encode(dict)
            Response.End
        End If
        
        '普通请求输出404页面
        Dim tpl : tpl = LoadTemplate(GetConfig("404Template"))
        If tpl = "" Then tpl = LoadTemplate("FastAsp/Templates/404.tpl")
        
        Response.Write tpl
        Response.End
    End Sub
    
    '显示维护页面
    Public Sub ShowMaintain(byval data)
        Response.Clear
        
        Dim dict, key, tpl
        
        '判断是否为Ajax请求
        If IsAjax() Then
            Response.ContentType = "application/json"
            Response.Charset = "utf-8"
            
            Set dict = Server.CreateObject("Scripting.Dictionary")
            dict.Add "code", -1
            dict.Add "msg", "系统维护中"
            If TypeName(data) = "Dictionary" Then
                For Each key In data.Keys
                    dict.Add key, data(key)
                Next
            End If
            
            Response.Write JSON.Encode(dict)
            Response.End
        End If
        
        '普通请求输出维护页面
        tpl = LoadTemplate(GetConfig("MaintainTemplate"))
        If tpl = "" Then tpl = LoadTemplate("FastAsp/Templates/maintain.tpl")
        
        '替换模板变量
        If TypeName(data) = "Dictionary" Then
            For Each key In data.Keys
                tpl = Replace(tpl, "{$" & key & "}", data(key))
            Next
        End If
        
        Response.Write tpl
        Response.End
    End Sub
    
    Private Sub Class_Terminate()
        Set m_Headers = Nothing
    End Sub
End Class
%> 